home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DIRS.SWG / 0041_Search ALL Drives.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  4KB  |  159 lines
  1. {
  2. FROM:    Arnim Noeldechen, 100016,2771
  3. TO:    gayle davis, 72067,2726
  4. DATE:    12/21/94 1:08 PM
  5. {
  6. Hello gayle,
  7.  
  8. thank you for giving us the great SWAG library. Its always a source
  9. of inspiration to me.
  10.  
  11. I send you a contribution which was inspired by the drives2.pas
  12. snippet.
  13.  
  14. SearchAllDrives looks for a file on all available Drives local
  15. and remote. It screens out Drives with identical VolumeId. It
  16. can handle netware-drives - mapped to different directories -
  17. because of the identical volumeid.
  18.  
  19. bye
  20. Arnim Noeldechen
  21. 100016,2771@compuserve.com
  22. -------------------------------
  23. {TURBO 6.0}
  24. {$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,R+,S+,V-,X+}
  25. {$M 16384,0,655360}
  26. program SearchAllDrives;
  27.  
  28. uses dos, crt;
  29.  
  30. type
  31.     charset = set of char;
  32. var sDrv,
  33.     s : string;
  34.     i,
  35.     bDrives : byte;
  36.     fFound : boolean;
  37.  
  38. function upCaseSt ( s : string ) : string;
  39.   var i : byte;
  40.   begin
  41.     for i := 1 to Length(s) do
  42.       s[i] := UpCase(s[i]);
  43.     upCaseSt := s;
  44.   end;
  45.  
  46. function AddBackSlash ( path : string ) : string;
  47.   begin
  48.     AddBackSlash := path;
  49.     if path [length(path)]<>'\' then
  50.       AddBackSlash := path+'\';
  51.   end;
  52.  
  53. function WordCount ( s : string; Sep : charset) : byte;
  54.   var i, cnt : byte;
  55.   begin
  56.     cnt := 0;
  57.     for i := 1 to length (s) do begin
  58.       if s [i] in Sep then inc (cnt);
  59.     end;
  60.     WordCount := cnt;
  61.   end;
  62.  
  63. function GetWord ( n : byte; s : string; Sep : charset) : string;
  64.   var
  65.     I, Count, bLenW,
  66.     bLenS : Byte;
  67.     sWord : string;
  68.   begin
  69.     Count := 1; I := 1; bLenW := 0; bLenS := length (s);
  70.     GetWord := ''; sWord := '';
  71.  
  72.     while (I <= bLenS) and (Count <= N) do begin
  73.       if s[i] in Sep then begin
  74.         inc (i);
  75.         inc (Count);
  76.       end;
  77.       while (I <= bLenS) and not(S[I] in Sep) do begin
  78.         if Count = N then begin
  79.           Inc(bLenW);
  80.           sword[0] := Char(bLenW);
  81.           sword[bLenW] := S[I];
  82.         end;
  83.         Inc(I);
  84.       end;
  85.     end;
  86.     GetWord := sWord;
  87.   end;
  88.  
  89. Procedure GetDriveList (var DriveList : string);
  90.  
  91. Var
  92.   Count   : Integer;
  93.   DirInfo : SearchRec;
  94.   s       : string;
  95.   DrvLst  : string;
  96.  
  97. begin
  98.   DriveList :='';
  99.   s := ''; DrvLst := '';
  100.   Writeln('You have Drives: ');
  101.   For Count := 3 to 26 do
  102.   if DiskSize(Count) > 0 then begin
  103.     FINDfirst (chr(64+Count)+':\*.*',VolumeID,DirInfo);
  104.     if pos(DIRINFO.Name,s)=0 then begin
  105.       s := s+DIRINFO.NAME;
  106.       Write (UpCase(Chr(ord('a') - 1 + Count)),': - ');
  107.       writeln (DIRINFO.Name);
  108.       DrvLst := DrvLst + UpCase(Chr(ord('a') - 1 + Count))+':'+';';
  109.     end;
  110.   end;
  111.   WriteLn;
  112.   DriveList := DrvLst;
  113. end;
  114.  
  115. procedure _dirscan ( sdir : string; ind, Search : string);
  116.   var dirinfo : SearchRec;
  117.   begin
  118.     if fFound then exit;
  119.     findfirst (addBackSlash(sdir)+'*.*',AnyFile,DirInfo);
  120.     while DosError = 0 do begin
  121.       gotoXY(1,wherey);
  122.       DelLine;
  123.       write (ind,addBackSlash(sdir)+DirInfo.Name);
  124.       if Dirinfo.name=search then begin
  125.         fFound := true;
  126.         exit;
  127.       end;
  128.       if ((DirInfo.Attr and Directory)=Directory) and
  129.          (DirInfo.Name[1]<>'.') then begin
  130.         _dirscan (addBackSlash(addBackSlash(sdir)+DirInfo.Name),Ind+'  ',Search);
  131.         if fFound then exit;
  132.       end;
  133.       FindNext(DirInfo);
  134.     end;
  135.   end;
  136.  
  137. procedure dirscan ( sdir : string; ind, Search : string);
  138.   begin
  139.     _dirscan (sdir,ind, upcasest(Search));
  140.     gotoXY(1,whereY);
  141.     DelLine;
  142.     if fFound then write('File '+Search+' found.')
  143.       else write ('File '+Search+' not found.');
  144.   end;
  145.  
  146. begin
  147.   fFound := false;
  148.   GetDriveList (s);
  149.   bDrives := WordCount (s,[';']);
  150.   for i := 1 to bDrives do
  151.   begin
  152.     sDrv := addBackSlash(GetWord (i,s,[';']));
  153.     writeln ('Checking Drive ',sDrv);
  154.     dirscan (sDrv,'','NAME.EXT');
  155.     writeln;
  156.   end;
  157. end.
  158. -----------------------------------------------
  159.